1 Introducción


1.1 Presentación

En esta práctica se elabora un caso práctico orientado a aprender a identificar los datos relevantes para un proyecto analítico y usar las herramientas de integración, limpieza, validación y análisis de los mismos.

1.2 Objetivos

● Aprender a aplicar los conocimientos adquiridos y su capacidad de resolución de problemas en entornos nuevos o poco conocidos dentro de contextos más amplios o multidisciplinares.

● Saber identificar los datos relevantes y los tratamientos necesarios (integración, limpieza y validación) para llevar a cabo un proyecto analítico.

● Aprender a analizar los datos adecuadamente para abordar la información contenida en los datos.

● Identificar la mejor representación de los resultados para aportar conclusiones sobre el problema planteado en el proceso analítico.

● Actuar con los principios éticos y legales relacionados con la manipulación de datos en función del ámbito de aplicación.

● Desarrollar las habilidades de aprendizaje que les permitan continuar estudiando de un modo que tendrá que ser en gran medida autodirigido o autónomo.

● Desarrollar la capacidad de búsqueda, gestión y uso de información y recursos en el ámbito de la ciencia de datos.


2 Descripción del dataset: “Heart Attack Analysis & Prediction dataset”


El conjunto de datos escogido para esta práctica, se titula: “Heart Attack Analysis & Prediction dataset”, el cual tiene como objetivo detectar aquellos factores que pueden actuar como potenciales precursores de las enfermedades cardiovasculares, y así ayudar a la detección y gestión temprana mediante la creación de un modelo. En el conjunto de datos se contemplan un total de 14 características importantes que pueden ayudar a la predicción de desarrollar o no una enfermedad cardíaca. Según la información encontrada, se sabe que las enfermedades cardiovasculares ocupan un porcentaje del 31% en relación a las muertes que se producen en el mundo cada año, por lo que supone una de las causas principales de muerte. Es importane tener en cuenta cuales son los atributos que pueden conllevar a un mayor riesgo cardiovascular o al desarrollo de enfermedad cardiovascular, por lo que, el objetivo es predecir que variables influyen más en este desarrollo.

A continuación, realizamos la descripción de las variables que hay en el dataset “Heart Attack Analysis & Prediction dataset”, usando la información encontrada en la web [Kaggle datasets] (https://www.kaggle.com/datasets), concretamente en el siguiente enlace: https://www.kaggle.com/datasets/rashikrahmanpritom/heart-attack-analysis-predictiondataset

++ Value 1 : Angina típica (TA)

++ Value 2 : Angina atípica (ATA)

++ Value 3 : Dolor no-anginal (NAP)

++ Value 4 : Asintomático (ASY)

++ Value 0 : Normal

++ Value 1 : Presentar anomalías de la onda ST-T (inversión de la onda T y/o elevación o depresión del ST de > 0,05 mV)

++ Value 2 : Hipertrofia ventricular izquierda probable o definida según los criterios de Estes


3 Integración y selección de los datos de interés a analizar.


Puede ser el resultado de adicionar diferentes datasets o una subselección útil de los datos originales, en base al objetivo que se quiera conseguir.

Primero de todo, cargamos las librerías que vamos a usar durante la práctica

if (!require('dplyr')) install.packages('dplyr');library(dplyr)
## Loading required package: dplyr
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
if (!require('ggplot2')) install.packages('ggplot2');library(ggplot2)
## Loading required package: ggplot2
if (!require('reshape')) install.packages('reshape');library(reshape)
## Loading required package: reshape
## 
## Attaching package: 'reshape'
## The following object is masked from 'package:dplyr':
## 
##     rename
if (!require('plotly')) install.packages('plotly');library(plotly)
## Loading required package: plotly
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:reshape':
## 
##     rename
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
if (!require('plyr')) install.packages('plyr');library(plyr)
## Loading required package: plyr
## ------------------------------------------------------------------------------
## You have loaded plyr after dplyr - this is likely to cause problems.
## If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
## library(plyr); library(dplyr)
## ------------------------------------------------------------------------------
## 
## Attaching package: 'plyr'
## The following objects are masked from 'package:plotly':
## 
##     arrange, mutate, rename, summarise
## The following objects are masked from 'package:reshape':
## 
##     rename, round_any
## The following objects are masked from 'package:dplyr':
## 
##     arrange, count, desc, failwith, id, mutate, rename, summarise,
##     summarize
if (!require('Stat2Data')) install.packages('Stat2Data');library(Stat2Data)
## Loading required package: Stat2Data
if (!require('corrplot')) install.packages('corrplot');library(corrplot)
## Loading required package: corrplot
## corrplot 0.92 loaded
if (!require('Matrix')) install.packages('matrix');library(Matrix)
## Loading required package: Matrix
## 
## Attaching package: 'Matrix'
## The following object is masked from 'package:reshape':
## 
##     expand
if (!require('patchwork')) install.packages('patchwork');library(patchwork)
## Loading required package: patchwork
if (!require('ggcorrplot')) install.packages('ggcorrplot');library(ggcorrplot)
## Loading required package: ggcorrplot
if (!require('corrplot')) install.packages('ggcorrplot');library(corrplot)

Cargamos los datos de la base de datos “heart” y tipificamos las variables que tiene el conjunto de datos como corresponde

library(readxl)
heart <- read_excel("~/Documents/AAESTUDIOS/UOC_Máster_Data_Science/4t_Semestre/Tipologia_Ciclodevida_datos/PR2/heart.xlsx")


# Mostramos los primeros registros del conjunto de dtos, con el fin de ver una aproximación de como es el conjunto y su estructura
head(heart, max(10))
## # A tibble: 10 × 14
##      age   sex    cp trtbps  chol   fbs restecg thalachh  exng oldpeak   slp
##    <dbl> <dbl> <dbl>  <dbl> <dbl> <dbl>   <dbl>    <dbl> <dbl>   <dbl> <dbl>
##  1    63     1     3    145   233     1       0      150     0     2.3     0
##  2    37     1     2    130   250     0       1      187     0     3.5     0
##  3    41     0     1    130   204     0       0      172     0     1.4     2
##  4    56     1     1    120   236     0       1      178     0     0.8     2
##  5    57     0     0    120   354     0       1      163     1     0.6     2
##  6    57     1     0    140   192     0       1      148     0     0.4     1
##  7    56     0     1    140   294     0       0      153     0     1.3     1
##  8    44     1     1    120   263     0       1      173     0     0       2
##  9    52     1     2    172   199     1       1      162     0     0.5     2
## 10    57     1     2    150   168     0       1      174     0     1.6     2
## # ℹ 3 more variables: caa <dbl>, thall <dbl>, output <dbl>
str(heart)
## tibble [303 × 14] (S3: tbl_df/tbl/data.frame)
##  $ age     : num [1:303] 63 37 41 56 57 57 56 44 52 57 ...
##  $ sex     : num [1:303] 1 1 0 1 0 1 0 1 1 1 ...
##  $ cp      : num [1:303] 3 2 1 1 0 0 1 1 2 2 ...
##  $ trtbps  : num [1:303] 145 130 130 120 120 140 140 120 172 150 ...
##  $ chol    : num [1:303] 233 250 204 236 354 192 294 263 199 168 ...
##  $ fbs     : num [1:303] 1 0 0 0 0 0 0 0 1 0 ...
##  $ restecg : num [1:303] 0 1 0 1 1 1 0 1 1 1 ...
##  $ thalachh: num [1:303] 150 187 172 178 163 148 153 173 162 174 ...
##  $ exng    : num [1:303] 0 0 0 0 1 0 0 0 0 0 ...
##  $ oldpeak : num [1:303] 2.3 3.5 1.4 0.8 0.6 0.4 1.3 0 0.5 1.6 ...
##  $ slp     : num [1:303] 0 0 2 2 2 1 1 2 2 2 ...
##  $ caa     : num [1:303] 0 0 0 0 0 0 0 0 0 0 ...
##  $ thall   : num [1:303] 1 2 2 2 2 1 2 3 3 2 ...
##  $ output  : num [1:303] 1 1 1 1 1 1 1 1 1 1 ...
# Definimos las variables como numéricas o categóricas
# Numéricas
heart$age<-as.numeric(heart$age)
heart$trtbps<-as.numeric(heart$trtbps)
heart$chol<-as.numeric(heart$chol)
heart$thalachh<-as.numeric(heart$thalachh)
heart$oldpeak<-as.numeric(heart$oldpeak)
heart$caa<-as.numeric(heart$caa)


# Categóricas
heart$sex<-as.factor(heart$sex)
heart$cp<-as.factor(heart$cp)
heart$fbs<-as.factor(heart$fbs)
heart$restecg<-as.factor(heart$restecg)
heart$exng<-as.factor(heart$exng)
heart$slp<-as.factor(heart$slp)
heart$thall<-as.factor(heart$thall)

# Observamos las dimensiones del dataset "heart"
heart.cols<-dim(heart)[2]
heart.rows<-dim(heart)[1]

Podemos ver como el conjunto de datos heart tiene 14 atributos y 303 observaciones

3.0.0.1 Seleccionamos datos dentro del conjunto que son de nuestro interés

# Creamos una nueva variable 'age_group' basada en la categoria de edad correspondiente
heart$age_group <- cut(heart$age, breaks = c(0, 30, 60, max(heart$age)), labels = c("Joven", "Adulto", "Mayor"))

# Ahora 'age_group' contiene categorías de edad en lugar de valores continuos
str(heart)
## tibble [303 × 15] (S3: tbl_df/tbl/data.frame)
##  $ age      : num [1:303] 63 37 41 56 57 57 56 44 52 57 ...
##  $ sex      : Factor w/ 2 levels "0","1": 2 2 1 2 1 2 1 2 2 2 ...
##  $ cp       : Factor w/ 4 levels "0","1","2","3": 4 3 2 2 1 1 2 2 3 3 ...
##  $ trtbps   : num [1:303] 145 130 130 120 120 140 140 120 172 150 ...
##  $ chol     : num [1:303] 233 250 204 236 354 192 294 263 199 168 ...
##  $ fbs      : Factor w/ 2 levels "0","1": 2 1 1 1 1 1 1 1 2 1 ...
##  $ restecg  : Factor w/ 3 levels "0","1","2": 1 2 1 2 2 2 1 2 2 2 ...
##  $ thalachh : num [1:303] 150 187 172 178 163 148 153 173 162 174 ...
##  $ exng     : Factor w/ 2 levels "0","1": 1 1 1 1 2 1 1 1 1 1 ...
##  $ oldpeak  : num [1:303] 2.3 3.5 1.4 0.8 0.6 0.4 1.3 0 0.5 1.6 ...
##  $ slp      : Factor w/ 3 levels "0","1","2": 1 1 3 3 3 2 2 3 3 3 ...
##  $ caa      : num [1:303] 0 0 0 0 0 0 0 0 0 0 ...
##  $ thall    : Factor w/ 4 levels "0","1","2","3": 2 3 3 3 3 2 3 4 4 3 ...
##  $ output   : num [1:303] 1 1 1 1 1 1 1 1 1 1 ...
##  $ age_group: Factor w/ 3 levels "Joven","Adulto",..: 3 2 2 2 2 2 2 2 2 2 ...
# Ahora el conjunto de datos heart tiene 15 atributos y 303 observaciones


# Seleccionamos sólo los pacientes con presión arterial alta, ya que tienen un mayor riesgo
heart <- heart[heart$trtbps > 140, ]

str(heart)
## tibble [65 × 15] (S3: tbl_df/tbl/data.frame)
##  $ age      : num [1:65] 63 52 57 58 66 43 61 71 59 46 ...
##  $ sex      : Factor w/ 2 levels "0","1": 2 2 2 1 1 2 2 1 2 1 ...
##  $ cp       : Factor w/ 4 levels "0","1","2","3": 4 3 3 4 4 1 3 2 3 3 ...
##  $ trtbps   : num [1:65] 145 172 150 150 150 150 150 160 150 142 ...
##  $ chol     : num [1:65] 233 199 168 283 226 247 243 302 212 177 ...
##  $ fbs      : Factor w/ 2 levels "0","1": 2 2 1 2 1 1 2 1 2 1 ...
##  $ restecg  : Factor w/ 3 levels "0","1","2": 1 2 2 1 2 2 2 2 2 1 ...
##  $ thalachh : num [1:65] 150 162 174 162 114 171 137 162 157 160 ...
##  $ exng     : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 2 1 1 2 ...
##  $ oldpeak  : num [1:65] 2.3 0.5 1.6 1 2.6 1.5 1 0.4 1.6 1.4 ...
##  $ slp      : Factor w/ 3 levels "0","1","2": 1 3 3 3 1 3 2 3 3 1 ...
##  $ caa      : num [1:65] 0 0 0 0 0 0 0 2 0 0 ...
##  $ thall    : Factor w/ 4 levels "0","1","2","3": 2 4 3 3 3 3 3 3 3 3 ...
##  $ output   : num [1:65] 1 1 1 1 1 1 1 1 1 1 ...
##  $ age_group: Factor w/ 3 levels "Joven","Adulto",..: 3 2 2 2 3 2 3 3 2 2 ...

Finalmente, después de la selección de datos, obtenemos el conjunto de datos heart con el que trabajaremos, el cual contiene un total de 15 atributos y 65 observaciones.

Ahora vamos a visualizar la información básica del conjunto de datos

# La variable output nos va indicar quien tiene o no una mayor probabilidad de sufrir un ataque al corazón, por lo que primero calculamos el porcentaje de pacientes que tienen mayor probabilidad y luego el resto

print("Porcentaje de personas con probabilidad de infarto")
## [1] "Porcentaje de personas con probabilidad de infarto"
round((sum(heart$output == 1)/nrow(heart)) * 100, 2)
## [1] 41.54
# Vemos que el porcentaje de personas con probabilidad de infarto es del 41,53%


print("Porcentaje de personas sin probabilidad de infarto")
## [1] "Porcentaje de personas sin probabilidad de infarto"
round((sum(heart$output == 0)/nrow(heart))*100,2)
## [1] 58.46
# Vemos que el porcentaje de personas sin probabilidad de infarto es del 58,46%

A continuación estudiamos la estadística básica de las variables del conjunto, cargando el sumario de todos los atributos

summary(heart)
##       age        sex    cp         trtbps         chol       fbs    restecg
##  Min.   :40.00   0:22   0:33   Min.   :142   Min.   :126.0   0:50   0:38   
##  1st Qu.:56.00   1:43   1: 5   1st Qu.:150   1st Qu.:225.0   1:15   1:26   
##  Median :59.00          2:16   Median :152   Median :244.0          2: 1   
##  Mean   :59.25          3:11   Mean   :157   Mean   :249.9                 
##  3rd Qu.:65.00                 3rd Qu.:160   3rd Qu.:282.0                 
##  Max.   :71.00                 Max.   :200   Max.   :407.0                 
##     thalachh     exng      oldpeak      slp         caa         thall 
##  Min.   : 88.0   0:41   Min.   :0.000   0: 8   Min.   :0.0000   0: 0  
##  1st Qu.:128.0   1:24   1st Qu.:0.200   1:33   1st Qu.:0.0000   1: 7  
##  Median :147.0          Median :1.000   2:24   Median :0.0000   2:25  
##  Mean   :144.3          Mean   :1.392          Mean   :0.8308   3:33  
##  3rd Qu.:161.0          3rd Qu.:2.300          3rd Qu.:2.0000         
##  Max.   :195.0          Max.   :6.200          Max.   :3.0000         
##      output        age_group 
##  Min.   :0.0000   Joven : 0  
##  1st Qu.:0.0000   Adulto:37  
##  Median :0.0000   Mayor :28  
##  Mean   :0.4154              
##  3rd Qu.:1.0000              
##  Max.   :1.0000
library(ggplot2)

# Edad (age)
summary(heart$age)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   40.00   56.00   59.00   59.25   65.00   71.00
g1<-ggplot(data=heart, aes(x=age))+
  geom_density(color="darkblue", fill="blue") + 
  labs(title = "Edad de los pacientes", x="Edad", y= "Densidad")
g1

# Sexo (sex)
summary(heart$sex)
##  0  1 
## 22 43
g2<-ggplot(data=heart, aes(x=sex))+
 geom_bar(mapping = aes(x=sex, fill=sex)) + 
  labs(title = "Sexo de los pacientes", x="Sexo", y= "Recuento") 
g2

# Dolor Torácico (cp)
summary(heart$cp)
##  0  1  2  3 
## 33  5 16 11
g3<-ggplot(data=heart, aes(x=cp))+
  geom_bar(aes(fill=cp)) + 
  facet_grid(~sex) +
  labs(title = "Distribución del Dolor Torácico", x="Dolor Torácico", y= "Recuento") 
g3

# Presión Arterial en Reposo (trtbps)
summary(heart$trtbps)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##     142     150     152     157     160     200
g4<-ggplot(data=heart, aes(x=trtbps))+
  geom_histogram(color="darkblue", fill="green") + 
  facet_grid(~sex) +
  labs(title = "Distribución de la Presión Arterial en Reposo", x="Presión Arterial en Reposo (mm Hg)", y= "Recuento") 
g4
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# Colesterol Sérico (chol)
summary(heart$chol)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   126.0   225.0   244.0   249.9   282.0   407.0
g5<-ggplot(data=heart, aes(x=chol))+
  geom_histogram(color="darkblue", fill="yellow") + 
  facet_grid(~sex) +
  labs(title = "Distribución del Colesterol Sérico", x="Colesterol Sérico (mm/dl)", y= "Recuento")
g5
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# Glucemia en ayunas (fbs)
summary(heart$fbs)
##  0  1 
## 50 15
g6<-ggplot(data=heart, aes(x=fbs))+
  geom_bar(fill="maroon4") + 
  facet_grid(~sex) +
  labs(title = "Distribución Glucemia en ayunas > 120", x="Glucemia en Ayunas", y= "Recuento") 
g6

# Electrocardiograma en Reposo (restecg)
summary(heart$restecg)
##  0  1  2 
## 38 26  1
g7<-ggplot(data=heart, aes(x=restecg))+
  geom_bar(aes(fill=restecg)) + 
  facet_grid(~sex) +
  labs(title = "Distribución ECG en Reposo", x="ECG en Reposo", y= "Recuento") 
g7

# Frecuencia Cardíaca Máxima (thalachh)
summary(heart$thalachh)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    88.0   128.0   147.0   144.3   161.0   195.0
g8<-ggplot(data=heart, aes(x=thalachh))+
  geom_density(color="darkblue", fill="brown") + 
  facet_grid(~sex) +
  labs(title = "Distribución Frecuencia Cardíaca Máxima alcanzada", x="Frecuencia Cardíaca Máxima", y= "Densidad")
g8

# Angina de Esfuerzo (exng)
summary(heart$exng)
##  0  1 
## 41 24
g9<-ggplot(data=heart, aes(x=exng))+
 geom_bar(aes(fill=exng)) + 
  facet_grid(~sex) +
  labs(title = "Distribución Anginas Inducidas por Esfuerzo", x="Angina Inducida por Esfuerzo", y= "Recuento") 
g9

# Antiguo pico (oldpeak)
summary(heart$oldpeak)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.000   0.200   1.000   1.392   2.300   6.200
g10<-ggplot(data=heart, aes(x=oldpeak))+
  geom_histogram(color="black", fill="turquoise") + 
  facet_grid(~sex) +
  labs(title = "Distribución Valor Medido en Depresión", x="Valor", y= "Recuento")
g10
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# Pendiente del Segmento ST máximo (slp)
summary(heart$slp)
##  0  1  2 
##  8 33 24
g11<-ggplot(data=heart, aes(x=slp))+
  geom_bar(aes(fill=slp))+ 
  facet_grid(~sex) +
  labs(title = "Distribución Pendiente ST", x="Pendiente ST", y= "Recuento") 
g11

# Número de grandes buques (caa)
summary(heart$caa)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.0000  0.0000  0.0000  0.8308  2.0000  3.0000
g12<-ggplot(data=heart, aes(x=caa))+
  geom_bar(fill="forestgreen")+ 
  facet_grid(~sex) +
  labs(title = "Distribución del Número de Buques", x="Nº de buques", y= "Recuento") 
g12

# Tasa de Mortalidad (thall)
summary(heart$thall)
##  0  1  2  3 
##  0  7 25 33
g13<-ggplot(data=heart, aes(x=thall))+
  geom_bar(aes(fill=thall))+ 
  facet_grid(~sex) +
  labs(title = "Distribución de la Tasa de Mortalidad", x="Tasa de mortalidad", y= "Recuento") 
g13

# Probabilidad Infarto (output)
summary(heart$output)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.0000  0.0000  0.0000  0.4154  1.0000  1.0000
g14<-ggplot(data=heart, aes(x=output))+
  geom_bar(fill="purple")+ 
  facet_grid(~sex) +
  labs(title = "Distribución Cardiopatía (Y/N)", x="Cardiopatía", y= "Recuento") 
g14

# Grupo de edad (age_group)
summary(heart$age_group)
##  Joven Adulto  Mayor 
##      0     37     28
g15<-ggplot(data=heart, aes(x=age_group))+
  geom_bar(aes(fill=age_group))+ 
  facet_grid(~sex) +
  labs(title = "Distribución de los grupos de edad", x="Grupo de edad", y= "Recuento") 
g15

# Visualizamos los resultados en una matriz de correlaciones, incluyendo todas las variables numéricas
library(ggcorrplot)
df2 <- heart[c(14, 1,4,5, 8, 10, 12)]
corr <- cor(round(df2, 2))
corr_chart<-ggcorrplot(corr ,hc.order=TRUE,lab=FALSE)
corr_chart


4 Limpieza de los datos


4.1 ¿Los datos contienen ceros o elementos vacíos? Gestiona cada uno de estos casos

# Hacemos cópia de los datos antes de iniciar la limpieza
heart_ld<-heart

# Primero determinamos el número de valores vacíos o valores en blanco
colSums(is.na(heart_ld))
##       age       sex        cp    trtbps      chol       fbs   restecg  thalachh 
##         0         0         0         0         0         0         0         0 
##      exng   oldpeak       slp       caa     thall    output age_group 
##         0         0         0         0         0         0         0
colSums(heart_ld=="")
##       age       sex        cp    trtbps      chol       fbs   restecg  thalachh 
##         0         0         0         0         0         0         0         0 
##      exng   oldpeak       slp       caa     thall    output age_group 
##         0         0         0         0         0         0         0
# Vemos como no hay ningun valor nulo en el conjunto de datos



# Estudiamos si hay valores que estén duplicados
sum(duplicated(heart_ld)) # Hay una fila que está repetida
## [1] 0
# Buscamos cual es la fila repetida
duplicated_rows <- duplicated(heart_ld)
duplicate_row <- heart_ld[duplicated_rows, ]

heart_ld <- unique(heart_ld)  # Eliminamos la fila duplicada

sum(duplicated(heart_ld)) # Comprobamos como ahora no hay ninguna fila duplicada
## [1] 0

4.2 Identifica y gestiona los valores extremos

Seguidamente es importante estudiar la posibilidad de valores outliers para las variables numéricas de la base de datos

# Para ello, creamos una función para que la podamos aplicar en cada uno de los atributos, de la cual obtengamos un gráfico Boxplot y una representación de puntos en forma de vector para poder visualizar mejor la posibilidad de valores outliers.

analisis_outliers <- function(variable, name){

# Creamos el gráfico
fig <- plot_ly(type = 'box')

# Representamos la variable
fig <- fig %>% add_boxplot(y = variable,
                           jitter = 0.3, 
                           pointpos = -1.8, 
                           boxpoints = 'all',
                           marker = list(color = 'rgb(47,79,79)'),
                           line = list(color = 'rgb(220,20,60)'),
                           fillcolor= list(color='rgb(220,20,60)'),
                           name = name)

fig <- fig %>% layout(title = paste("Análisis de valores Outliers de la variable", name))

# Obtenemos los posibles outliers
outliers <- boxplot.stats(variable)$out

return(list(outliers=outliers, fig=fig))
}



# Age
# Obtenemos la lista resultante de la función de análisis de outliers.
analisis = analisis_outliers(heart_ld$age,"Age")

# Representamos los datos con un gráfico BoxPlot
analisis$fig 
# No hay valores outliers



# Resting Blood Pressure (trtbps)
analisis = analisis_outliers(heart_ld$trtbps,"Resting Blood Pressure")
analisis$fig 
# Tampoco encontramos valores outliers, ya que, al filtrar con valores > 140, entendemos que todos los valores son posibles



# Cholesterol (chol)
analisis = analisis_outliers(heart_ld$chol,"Cholesterol")
analisis$fig
# Vemos que la distribución está centrada entre 126 y 400, por lo que no hay ningún punto outlier.



# Maximum Heart Rate (thalachh)
analisis = analisis_outliers(heart_ld$thalachh,"Maximum Heart Rate")
analisis$fig 
# No se observan valores outliers



# Oldpeak (oldpeak)
analisis = analisis_outliers(heart_ld$oldpeak,"Oldpeak")
analisis$fig 
# Hay puntos que podrían ser valores outliers

# Visualizamos los valores candidatos a outliers
analisis$outliers
## [1] 6.2
# Vemos como es posible que se den estos valores, por lo que no hacemos ninguna acción en la variable

4.2.1 Resultado limpieza de datos

# Mostramos el resumen de los datos después de haber limpiado todo el conjunto
str(heart_ld)
## tibble [65 × 15] (S3: tbl_df/tbl/data.frame)
##  $ age      : num [1:65] 63 52 57 58 66 43 61 71 59 46 ...
##  $ sex      : Factor w/ 2 levels "0","1": 2 2 2 1 1 2 2 1 2 1 ...
##  $ cp       : Factor w/ 4 levels "0","1","2","3": 4 3 3 4 4 1 3 2 3 3 ...
##  $ trtbps   : num [1:65] 145 172 150 150 150 150 150 160 150 142 ...
##  $ chol     : num [1:65] 233 199 168 283 226 247 243 302 212 177 ...
##  $ fbs      : Factor w/ 2 levels "0","1": 2 2 1 2 1 1 2 1 2 1 ...
##  $ restecg  : Factor w/ 3 levels "0","1","2": 1 2 2 1 2 2 2 2 2 1 ...
##  $ thalachh : num [1:65] 150 162 174 162 114 171 137 162 157 160 ...
##  $ exng     : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 2 1 1 2 ...
##  $ oldpeak  : num [1:65] 2.3 0.5 1.6 1 2.6 1.5 1 0.4 1.6 1.4 ...
##  $ slp      : Factor w/ 3 levels "0","1","2": 1 3 3 3 1 3 2 3 3 1 ...
##  $ caa      : num [1:65] 0 0 0 0 0 0 0 2 0 0 ...
##  $ thall    : Factor w/ 4 levels "0","1","2","3": 2 4 3 3 3 3 3 3 3 3 ...
##  $ output   : num [1:65] 1 1 1 1 1 1 1 1 1 1 ...
##  $ age_group: Factor w/ 3 levels "Joven","Adulto",..: 3 2 2 2 3 2 3 3 2 2 ...
summary(heart_ld)
##       age        sex    cp         trtbps         chol       fbs    restecg
##  Min.   :40.00   0:22   0:33   Min.   :142   Min.   :126.0   0:50   0:38   
##  1st Qu.:56.00   1:43   1: 5   1st Qu.:150   1st Qu.:225.0   1:15   1:26   
##  Median :59.00          2:16   Median :152   Median :244.0          2: 1   
##  Mean   :59.25          3:11   Mean   :157   Mean   :249.9                 
##  3rd Qu.:65.00                 3rd Qu.:160   3rd Qu.:282.0                 
##  Max.   :71.00                 Max.   :200   Max.   :407.0                 
##     thalachh     exng      oldpeak      slp         caa         thall 
##  Min.   : 88.0   0:41   Min.   :0.000   0: 8   Min.   :0.0000   0: 0  
##  1st Qu.:128.0   1:24   1st Qu.:0.200   1:33   1st Qu.:0.0000   1: 7  
##  Median :147.0          Median :1.000   2:24   Median :0.0000   2:25  
##  Mean   :144.3          Mean   :1.392          Mean   :0.8308   3:33  
##  3rd Qu.:161.0          3rd Qu.:2.300          3rd Qu.:2.0000         
##  Max.   :195.0          Max.   :6.200          Max.   :3.0000         
##      output        age_group 
##  Min.   :0.0000   Joven : 0  
##  1st Qu.:0.0000   Adulto:37  
##  Median :0.0000   Mayor :28  
##  Mean   :0.4154              
##  3rd Qu.:1.0000              
##  Max.   :1.0000
#Volvemos a visualizar los datos en conjunto como al inicio, pero con los datos limpios

# Edad (age)
summary(heart_ld$age)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   40.00   56.00   59.00   59.25   65.00   71.00
g1<-ggplot(data=heart_ld, aes(x=age))+
  geom_density(color="darkblue", fill="blue") + 
  labs(title = "Edad de los pacientes", x="Edad", y= "Densidad")
g1

# Sexo (sex)
summary(heart_ld$sex)
##  0  1 
## 22 43
g2<-ggplot(data=heart_ld, aes(x=sex))+
 geom_bar(mapping = aes(x=sex, fill=sex)) + 
  labs(title = "Sexo de los pacientes", x="Sexo", y= "Recuento") 
g2

# Dolor Torácico (cp)
summary(heart_ld$cp)
##  0  1  2  3 
## 33  5 16 11
g3<-ggplot(data=heart_ld, aes(x=cp))+
  geom_bar(aes(fill=cp)) + 
  facet_grid(~sex) +
  labs(title = "Distribución del Dolor Torácico", x="Dolor Torácico", y= "Recuento") + theme_classic()
g3

# Presión Arterial en Reposo (trtbps)
summary(heart_ld$trtbps)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##     142     150     152     157     160     200
g4<-ggplot(data=heart_ld, aes(x=trtbps))+
  geom_histogram(color="darkblue", fill="green") + 
  facet_grid(~sex) +
  labs(title = "Distribución de la Presión Arterial en Reposo", x="Presión Arterial en Reposo (mm Hg)", y= "Recuento") 
g4
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# Colesterol Sérico (chol)
summary(heart_ld$chol)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   126.0   225.0   244.0   249.9   282.0   407.0
g5<-ggplot(data=heart_ld, aes(x=chol))+
  geom_histogram(color="darkblue", fill="yellow") + 
  facet_grid(~sex) +
  labs(title = "Distribución del Colesterol Sérico", x="Colesterol Sérico (mm/dl)", y= "Recuento")
g5
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# Glucemia en ayunas (fbs)
summary(heart_ld$fbs)
##  0  1 
## 50 15
g6<-ggplot(data=heart_ld, aes(x=fbs))+
  geom_bar(fill="maroon4") + 
  facet_grid(~sex) +
  labs(title = "Distribución Glucemia en ayunas > 120", x="Glucemia en Ayunas", y= "Recuento") 
g6

# Electrocardiograma en Reposo (restecg)
summary(heart_ld$restecg)
##  0  1  2 
## 38 26  1
g7<-ggplot(data=heart_ld, aes(x=restecg))+
  geom_bar(aes(fill=restecg)) + 
  facet_grid(~sex) +
  labs(title = "Distribución ECG en Reposo", x="ECG en Reposo", y= "Recuento") 
g7

# Frecuencia Cardíaca Máxima (thalachh)
summary(heart_ld$thalachh)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    88.0   128.0   147.0   144.3   161.0   195.0
g8<-ggplot(data=heart_ld, aes(x=thalachh))+
  geom_density(color="darkblue", fill="brown") + 
  facet_grid(~sex) +
  labs(title = "Distribución Frecuencia Cardíaca Máxima alcanzada", x="Frecuencia Cardíaca Máxima", y= "Densidad")
g8

# Angina de Esfuerzo (exng)
summary(heart_ld$exng)
##  0  1 
## 41 24
g9<-ggplot(data=heart_ld, aes(x=exng))+
 geom_bar(aes(fill=exng)) + 
  facet_grid(~sex) +
  labs(title = "Distribución Anginas Inducidas por Esfuerzo", x="Angina Inducida por Esfuerzo", y= "Recuento") 
g9

# Antiguo pico (oldpeak)
summary(heart_ld$oldpeak)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.000   0.200   1.000   1.392   2.300   6.200
g10<-ggplot(data=heart_ld, aes(x=oldpeak))+
  geom_histogram(color="black", fill="turquoise") + 
  facet_grid(~sex) +
  labs(title = "Distribución Valor Medido en Depresión", x="Valor", y= "Recuento")
g10
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# Pendiente del Segmento ST máximo (slp)
summary(heart_ld$slp)
##  0  1  2 
##  8 33 24
g11<-ggplot(data=heart_ld, aes(x=slp))+
  geom_bar(aes(fill=slp))+ 
  facet_grid(~sex) +
  labs(title = "Distribución Pendiente ST", x="Pendiente ST", y= "Recuento") 
g11

# Número de grandes buques (caa)
summary(heart_ld$caa)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.0000  0.0000  0.0000  0.8308  2.0000  3.0000
g12<-ggplot(data=heart_ld, aes(x=caa))+
  geom_bar(fill="forestgreen")+ 
  facet_grid(~sex) +
  labs(title = "Distribución del Número de Buques", x="Nº de buques", y= "Recuento") 
g12

# Tasa de Mortalidad (thall)
summary(heart_ld$thall)
##  0  1  2  3 
##  0  7 25 33
g13<-ggplot(data=heart_ld, aes(x=thall))+
  geom_bar(aes(fill=thall))+ 
  facet_grid(~sex) +
  labs(title = "Distribución de la Tasa de Mortalidad", x="Tasa de mortalidad", y= "Recuento") 
g13

# Variable Cardiopatía (output)
summary(heart_ld$output)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.0000  0.0000  0.0000  0.4154  1.0000  1.0000
g14<-ggplot(data=heart_ld, aes(x=output))+
  geom_bar(fill="purple")+ 
  facet_grid(~sex) +
  labs(title = "Distribución Cardiopatía (Y/N)", x="Cardiopatía", y= "Recuento") 
g14

# Grupo de edad (age_group)
summary(heart_ld$age_group)
##  Joven Adulto  Mayor 
##      0     37     28
g15<-ggplot(data=heart_ld, aes(x=age_group))+
  geom_bar(aes(fill=age_group))+ 
  facet_grid(~sex) +
  labs(title = "Distribución de los grupos de edad", x="Grupo de edad", y= "Recuento") 
g15

# Visualizamos los resultados en una matriz de correlaciones, incluyendo todas las variables
library(ggcorrplot)
df2 <- heart_ld[c(14, 1,4,5, 8, 10, 12)]
corr <- cor(round(df2, 2))
corr_chart<-ggcorrplot(corr ,hc.order=TRUE,lab=FALSE)
corr_chart

4.3 Discretización de los datos

# De la misma manera que en la limpieza de los datos, creamos una cópia para trabajar la discretización de las variables
heart_discr<-heart_ld


# A continuación iniciamos el proceso de discretización de las variables para poder realizar correctamente los análisis posteriormente 

# Age
heart_discr["age"] <- cut(heart_discr$age, breaks=c(-Inf, 40,65,+Inf),
                      labels=c("Adulto","Mediana edad","Tercera edad"))
# Comprobamos como quedan los datos
summary(heart_discr$age)
##       Adulto Mediana edad Tercera edad 
##            1           49           15
# Resting Blood Pressure
heart_discr["trtbps"] <- cut(heart_discr$trtbps, breaks=c(-Inf, 120, 140,+Inf),
                      labels=c("Normal","Alta","Muy Alta"))
# Comprobamos como quedan los datos
summary(heart_discr$trtbps)
##   Normal     Alta Muy Alta 
##        0        0       65
# Cholesterol
heart_discr["chol"] <- cut(heart_discr$chol, breaks=c(-Inf, 200, 240,+Inf),
                      labels=c("Normal","Alto","Muy Alto"))
# Comprobamos como quedan los datos
summary(heart_discr$chol)
##   Normal     Alto Muy Alto 
##        9       20       36
# Maximum Rate Freq
heart_discr["thalachh"] <- cut(heart_discr$thalachh, breaks=c(-Inf, 120, 160,+Inf),
                      labels=c("Normal","Alto","Muy Alto"))
# Comprobamos como quedan los datos
summary(heart_discr$thalachh)
##   Normal     Alto Muy Alto 
##       12       36       17
# Oldpeak
heart_discr["oldpeak"] <- cut(heart_discr$oldpeak, breaks=c(-Inf, 2, 2.55, +Inf),
                      labels=c("Normal","Alto","Muy Alto"))
# Comprobamos como quedan los datos
summary(heart_discr$oldpeak)
##   Normal     Alto Muy Alto 
##       48        2       15

5 Análisis de los datos


5.1 Selección de los grupos de datos que se quieren analizar/comparar

(p.ej., si se van a comparar grupos de datos, ¿cuáles son estos grupos y qué tipo de análisis se van a aplicar?)

Para analizar y comparar los datos seleccionados, dividiremos el enfoque en tres partes, centrándonos en la predicción de ataques cardíacos (variable “output”) en relación con las variables de interés. Dividiremos el análisis en tres partes sobre las variables que anteriormente hemos seleccionado. El objetivo y la respuesta a contestar es el tratar de aclarar que tipo de condiciones ayudan a predecir con mejor medida un ataque al corazón.

Los análisis que realizaremos son los siguientes

Matriz de Correlaciones: Exploraremos las relaciones lineales entre todas las variables seleccionadas. Este análisis nos mostrará cómo se correlacionan entre sí las variables, permitiendo identificar asociaciones y patrones de relación, lo que podría sugerir qué variables están más estrechamente relacionadas con la presencia de ataques cardíacos.

ANOVA (Análisis Comparativo): Evaluaremos la diferencia en la variable de salida (“output”) en función de todas las variables incluidas también en la matriz de correlación. Esto nos permite determinar si hay diferencias significativas en la media de “output” entre los distintos niveles de estas variables.

Modelo Predictivo (Regresión Logística): Utilizaremos una regresión logística para predecir la ocurrencia de ataques cardíacos (“output”) basándonos en las variables con una correlación relevante en la matriz anterior. Analizaremos variables como el tipo de dolor torácico, frecuencia cardíaca máxima alcanzada, tasa de mortalidad, angina inducida por el ejercicio, pendiente del segmento ST máximo del ejercicio y el número de grandes buques. El objetivo es comprender qué variables son predictivas de ataques cardíacos y en qué medida influyen en la predicción.

Estos análisis proporcionarán una visión detallada sobre cómo las diferentes variables están relacionadas con la presencia de ataques cardíacos y qué factores pueden ser más relevantes para predecirlos.

5.2 Comprobación de la normalidad y homogeneidad de la varianza.

5.2.1 Comprobación de Normalidad

Para evaluar la normalidad de las variables seleccionadas, empleamos la prueba de Spahiro-Wilk

# Una vez tenemos los datos discretizados, comprobamos la normalidad

# Usamos la prueba de Shapiro-Wilk para verificar la normalidad de cada variable numérica
variables <- c("age", "trtbps", "chol", "thalachh", "oldpeak")
resultados_shapiro <- lapply(heart_ld[variables], shapiro.test)
names(resultados_shapiro) <- variables

# Verificar la estructura de las variables seleccionadas en el conjunto de datos 'heart'
str(heart_ld[, variables])
## tibble [65 × 5] (S3: tbl_df/tbl/data.frame)
##  $ age     : num [1:65] 63 52 57 58 66 43 61 71 59 46 ...
##  $ trtbps  : num [1:65] 145 172 150 150 150 150 150 160 150 142 ...
##  $ chol    : num [1:65] 233 199 168 283 226 247 243 302 212 177 ...
##  $ thalachh: num [1:65] 150 162 174 162 114 171 137 162 157 160 ...
##  $ oldpeak : num [1:65] 2.3 0.5 1.6 1 2.6 1.5 1 0.4 1.6 1.4 ...
# Mostramos los resultados
print(resultados_shapiro)
## $age
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.95453, p-value = 0.01792
## 
## 
## $trtbps
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.86409, p-value = 3.916e-06
## 
## 
## $chol
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.98135, p-value = 0.4328
## 
## 
## $thalachh
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.97832, p-value = 0.3102
## 
## 
## $oldpeak
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.88182, p-value = 1.542e-05

Los resultados de la normalidad muestran que para la variable ‘age’ (edad) hay evidencia suficiente para rechazar la hipótesis nula y afirmar que los datos no siguen una distribución normal, igual que la variable ‘trtbps’ (presión arterial en reposo) y la variable ‘oldpeak’, donde la evidencia para rechazar la hipótesis de normalidad es más fuerte.

Por otro lado, ni la variable ‘chol’ (colesterol) ni la variable ‘thalachh’ (ritmo cardíaco máximo aclanzada) muestran suficiente evidencia para rechazar la hipótesis nula de normalidad, sugiriendo que los datos de ambas variables podrían seguir una distribución normal.

5.2.2 Comprobación de Varianza

Calculamos las varianzas de las variables numéricas agrupadas por categorías de edad. Esto nos va a proporcionar una visión de como varían ‘age’, ‘trtbps’, ‘chol’, ‘thalachh’, y ‘oldpeak’ en distintos grupos de edad en el riesgo de sufrir un ataque cardíaco.

# A continuación comprobamos la varianza, en función del grupo de edad al que pertenece

# Calculamos las varianzas de las variables numéricas por grupos de edad
varianzas_por_edad <- aggregate(cbind(age, trtbps, chol, thalachh, oldpeak) ~ age_group, data = heart_ld, FUN = var)
print(varianzas_por_edad)
##   age_group       age   trtbps     chol thalachh  oldpeak
## 1    Adulto 30.863363 195.8363 2083.790 695.5465 1.578078
## 2     Mayor  8.469577 109.8029 2852.787 291.9894 2.138029

Clasificamos la varible ‘output’ en dos categorías (‘Yes’ y ’No) para investigar las varianzas de las variables numéricas respecto a la probabilidad de sufrir un ataque cardíaco

# Calculamos las varianzas de las variables numéricas según si tiene riesgo de ataque al corazón o no

# Antes de nada clasificamos la variable 'output' en dos categorías ("Yes" y "No")
heart_var<-heart_ld
heart_var$output <- factor(heart_var$output, levels = c(0, 1), labels = c("No", "Yes"))
# Comprobamos como quedan los datos
summary(heart_var$output)
##  No Yes 
##  38  27
varianzas_por_output <- aggregate(cbind(age, trtbps, chol, thalachh, oldpeak) ~ output, data = heart_var, FUN = var)
print(varianzas_por_output)
##   output      age   trtbps     chol thalachh  oldpeak
## 1     No 46.13656 196.8798 2394.200 542.7994 2.216508
## 2    Yes 62.39601 100.1795 2385.538 308.9088 1.002080

Los resultados resaltan las diferencias en las varianzas de estas variables entre aquellos casos con mayor probabilidad de sufrir un ataque cardíaco y los que no.

Esta evaluación proporciona una visión detallada de cómo las variables numéricas varían en relación con la edad y la probabilidad de sufrir un ataque cardíaco, lo que puede ser fundamental para comprender los factores de riesgo asociados

5.3 Aplicación de pruebas estadísticas para comparar los grupos de datos

5.3.1 Matriz Correlaciones

Mediante la creación de una matriz de correlaciones, procederemos a estudiar la relación que hay entre cada uno de los atributos del conjunto de datos, mediante los datos limpios sin la discretización (heart_ld) y convertimos aquellas variables categóricas en númericas

# Creamos una cópia de los datos limpios sin discretizar para convertirlos todos en numéricos, y teniendo en cuenta la información aportada en la descripción de las variables
heart_cor <-heart_ld


# sex
heart_cor$sex <- as.numeric(as.character(heart_cor$sex))

# cp
heart_cor$cp <- as.numeric(as.character(heart_cor$cp))

# fbs
heart_cor$fbs <- as.numeric(as.character(heart_cor$fbs))

# restecg
heart_cor$restecg <- as.numeric(as.character(heart_cor$restecg))

# exng
heart_cor$exng <- as.numeric(as.character(heart_cor$exng))

# slp
heart_cor$slp <- as.numeric(as.character(heart_cor$slp))

# thall
heart_cor$thall <- as.numeric(as.character(heart_cor$thall))

# output
heart_cor$output <- as.numeric(as.character(heart_cor$output))


# Imprimimos la estructura de este nuevo dataset para ver como han sido transformadas las variables
str(heart_cor)
## tibble [65 × 15] (S3: tbl_df/tbl/data.frame)
##  $ age      : num [1:65] 63 52 57 58 66 43 61 71 59 46 ...
##  $ sex      : num [1:65] 1 1 1 0 0 1 1 0 1 0 ...
##  $ cp       : num [1:65] 3 2 2 3 3 0 2 1 2 2 ...
##  $ trtbps   : num [1:65] 145 172 150 150 150 150 150 160 150 142 ...
##  $ chol     : num [1:65] 233 199 168 283 226 247 243 302 212 177 ...
##  $ fbs      : num [1:65] 1 1 0 1 0 0 1 0 1 0 ...
##  $ restecg  : num [1:65] 0 1 1 0 1 1 1 1 1 0 ...
##  $ thalachh : num [1:65] 150 162 174 162 114 171 137 162 157 160 ...
##  $ exng     : num [1:65] 0 0 0 0 0 0 1 0 0 1 ...
##  $ oldpeak  : num [1:65] 2.3 0.5 1.6 1 2.6 1.5 1 0.4 1.6 1.4 ...
##  $ slp      : num [1:65] 0 2 2 2 0 2 1 2 2 0 ...
##  $ caa      : num [1:65] 0 0 0 0 0 0 0 2 0 0 ...
##  $ thall    : num [1:65] 1 3 2 2 2 2 2 2 2 2 ...
##  $ output   : num [1:65] 1 1 1 1 1 1 1 1 1 1 ...
##  $ age_group: Factor w/ 3 levels "Joven","Adulto",..: 3 2 2 2 3 2 3 3 2 2 ...
# Vemos que ahora todos los atributos son numéricos, por lo que podemos crear la matriz de correlaciones.


# Hacemos el cálculo de la matriz
# Primero quitamos la variable del grupo de edad
heart_cor <- heart_cor[, -15] 
corr <- round(cor(heart_cor), 1)


# Realizamos la representación gráfic con los resultados
col <- colorRampPalette(c("#0000CD", "#7D26CD", "#FFFFFF",
                          "#FF6347","#FF0000"))

corrplot(corr, method = "square", shade.col = NA, tl.col = "black",
         tl.srt = 45, col = col(200), addCoef.col = "black", order = "AOE", 
         type = "upper", diag = F, addshade = "all")

Viendo la matriz de correlaciones, podemos confirmar que existe una clara relación entre algunas de las variables incluidas en el conjunto de datos y el hecho de padecer un infarto cardiovascular. De la misma manera, vemos cuales son las diferentes relaciones entre las variables y la manera en que podemos reducir el riesgo de padecder un infarto, hecho que podemos estudiar con un análisis comparativo con ANOVA y usando un modelo predictivo a continuación.

# Mostramos la matriz de correlaciones que nos indica las relaciones entre las diferentes variables.
round(cor(heart_cor),2)
##            age   sex    cp trtbps  chol   fbs restecg thalachh  exng oldpeak
## age       1.00 -0.21  0.06   0.12  0.09  0.07    0.01    -0.25  0.00    0.06
## sex      -0.21  1.00  0.05  -0.15 -0.24  0.08   -0.16    -0.16 -0.06   -0.11
## cp        0.06  0.05  1.00  -0.01 -0.07  0.18    0.02     0.36 -0.45   -0.18
## trtbps    0.12 -0.15 -0.01   1.00  0.27  0.22    0.01     0.07  0.16    0.10
## chol      0.09 -0.24 -0.07   0.27  1.00 -0.19   -0.16    -0.02  0.21    0.02
## fbs       0.07  0.08  0.18   0.22 -0.19  1.00    0.04     0.06 -0.04    0.05
## restecg   0.01 -0.16  0.02   0.01 -0.16  0.04    1.00     0.09  0.04   -0.04
## thalachh -0.25 -0.16  0.36   0.07 -0.02  0.06    0.09     1.00 -0.38   -0.20
## exng      0.00 -0.06 -0.45   0.16  0.21 -0.04    0.04    -0.38  1.00    0.04
## oldpeak   0.06 -0.11 -0.18   0.10  0.02  0.05   -0.04    -0.20  0.04    1.00
## slp      -0.14  0.07  0.11  -0.10  0.01 -0.09    0.18     0.39 -0.34   -0.60
## caa       0.14 -0.12 -0.40   0.02  0.08  0.09   -0.20    -0.19  0.03    0.17
## thall    -0.14  0.13 -0.13   0.07  0.09 -0.05   -0.05     0.09  0.07    0.14
## output    0.01 -0.12  0.63  -0.13 -0.11  0.13    0.14     0.39 -0.39   -0.24
##            slp   caa thall output
## age      -0.14  0.14 -0.14   0.01
## sex       0.07 -0.12  0.13  -0.12
## cp        0.11 -0.40 -0.13   0.63
## trtbps   -0.10  0.02  0.07  -0.13
## chol      0.01  0.08  0.09  -0.11
## fbs      -0.09  0.09 -0.05   0.13
## restecg   0.18 -0.20 -0.05   0.14
## thalachh  0.39 -0.19  0.09   0.39
## exng     -0.34  0.03  0.07  -0.39
## oldpeak  -0.60  0.17  0.14  -0.24
## slp       1.00 -0.19 -0.12   0.35
## caa      -0.19  1.00  0.01  -0.40
## thall    -0.12  0.01  1.00  -0.27
## output    0.35 -0.40 -0.27   1.00

Nos fijamos en la variable que realmente nos interesa para saber que factores ayudan a predecir que se de un ataque al corazón, que es el output. Esta variable presenta una mayor correlación con ‘cp’ (tipo de dolor torácico), ‘thalachh’ (frecuencia cardíaca máxima alcanzada), ‘thall’ (tasa de mortalidad), ‘exng’ (angina inducida por el ejercicio), ‘slp’ (pendiente del segmento ST máximo del ejercicio) y ‘caa’ (número de grandes buques). Por tanto, estas serán las variables que analizaremos.

5.3.2 Analísis comparativo (ANOVA)

Para realizar un análisis comparativo de todas las variables numéricas y la variable output, empleamos la prueba estadística de ANOVA, prueba que evalúa si hay diferencias significativas en la media de la variable de salida entre los distintos niveles de las variables numéricas.

# ANOVA entre la variable de salida (output) y las variables numéricas
anova_output_age <- aov(output ~ age, data = heart_cor)
anova_output_trtbps <- aov(output ~ trtbps, data = heart_cor)
anova_output_chol <- aov(output ~ chol, data = heart_cor)
anova_output_thalachh <- aov(output ~ thalachh, data = heart_cor)
anova_output_oldpeak <- aov(output ~ oldpeak, data = heart_cor)
anova_output_caa <- aov(output ~ caa, data = heart_cor)

anova_output_sex <- aov(output ~ sex, data = heart_cor)
anova_output_cp <- aov(output ~ cp, data = heart_cor)
anova_output_fbs <- aov(output ~ fbs, data = heart_cor)
anova_output_restecg <- aov(output ~ restecg, data = heart_cor)
anova_output_exng <- aov(output ~ exng, data = heart_cor)
anova_output_slp <- aov(output ~ slp, data = heart_cor)
anova_output_thall <- aov(output ~ thall, data = heart_cor)


# Resumen de los resultados del ANOVA
summary(anova_output_age)
##             Df Sum Sq Mean Sq F value Pr(>F)
## age          1  0.003 0.00338   0.013  0.908
## Residuals   63 15.781 0.25050
summary(anova_output_trtbps)
##             Df Sum Sq Mean Sq F value Pr(>F)
## trtbps       1  0.259  0.2587    1.05  0.309
## Residuals   63 15.526  0.2464
summary(anova_output_chol)
##             Df Sum Sq Mean Sq F value Pr(>F)
## chol         1  0.206  0.2055   0.831  0.365
## Residuals   63 15.579  0.2473
summary(anova_output_thalachh)
##             Df Sum Sq Mean Sq F value  Pr(>F)   
## thalachh     1  2.386  2.3858   11.22 0.00137 **
## Residuals   63 13.399  0.2127                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(anova_output_oldpeak)
##             Df Sum Sq Mean Sq F value Pr(>F)  
## oldpeak      1  0.906  0.9061   3.837 0.0546 .
## Residuals   63 14.878  0.2362                 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(anova_output_caa)
##             Df Sum Sq Mean Sq F value   Pr(>F)    
## caa          1  2.536  2.5357   12.06 0.000938 ***
## Residuals   63 13.249  0.2103                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(anova_output_sex)
##             Df Sum Sq Mean Sq F value Pr(>F)
## sex          1  0.238  0.2381   0.965   0.33
## Residuals   63 15.547  0.2468
summary(anova_output_cp)
##             Df Sum Sq Mean Sq F value   Pr(>F)    
## cp           1  6.179   6.179   40.53 2.51e-08 ***
## Residuals   63  9.605   0.152                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(anova_output_fbs)
##             Df Sum Sq Mean Sq F value Pr(>F)
## fbs          1  0.271  0.2713   1.102  0.298
## Residuals   63 15.513  0.2462
summary(anova_output_restecg)
##             Df Sum Sq Mean Sq F value Pr(>F)
## restecg      1  0.313  0.3129   1.274  0.263
## Residuals   63 15.472  0.2456
summary(anova_output_exng)
##             Df Sum Sq Mean Sq F value  Pr(>F)   
## exng         1  2.354  2.3537   11.04 0.00149 **
## Residuals   63 13.431  0.2132                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(anova_output_slp)
##             Df Sum Sq Mean Sq F value  Pr(>F)   
## slp          1  1.927   1.927   8.761 0.00433 **
## Residuals   63 13.857   0.220                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(anova_output_thall)
##             Df Sum Sq Mean Sq F value Pr(>F)  
## thall        1  1.136  1.1365   4.888 0.0307 *
## Residuals   63 14.648  0.2325                 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Parece que la frecuencia cardíaca máxima alcanzada (thalachh), el número de grandes vasos (caa), el tipo de dolor de pecho (cp), la presencia de angina inducida por el ejercicio (exng) y, en menor medida, el tipo de pendiente del segmento ST del electrocardiograma en reposo (slp), la tasa de mortalidad (thall) y la depresión inducida por el ejercicio (oldpeak), muestran asociaciones significativas con la presencia de enfermedades cardíacas. Estos hallazgos, indicados por los valores de p altamente significativos , podrían sugerir la importancia de estas variables en la predicción o diagnóstico de enfermedades cardíacas en el conjunto de datos analizado.

Por otro lado, variables como la edad (age), el sexo (sex), el nivel de azúcar en sangre en ayunas (fbs), el resultado del electrocardiograma en reposo (restecg), la presión arterial en reposo (trtbps) y el colesterol (chol) no parecen demostrar una asociación significativa con la variable de salida (output) en este análisis, ya que sus valores p no alcanzan niveles de significancia estadística.

Estos resultados proporcionan una visión inicial sobre qué variables podrían ser más relevantes al abordar problemas relacionados con enfermedades cardíacas en este contexto específico. Sin embargo, es importante tener en cuenta que estos hallazgos pueden requerir una validación adicional o un análisis más detallado para confirmar su relevancia clínica o predictiva, como lo haremos a continuación mediante un modelo de regresión logística

5.3.3 Modelado Predictivo (Regresión logística)

Para construir un modelo predictivo usando regresión logística con las variables seleccionadas del ANOVA anterior, usamos la función glm().

# Ajustamos un modelo de regresión logística para predecir enfermedades cardíacas
model <- glm(output ~ caa + cp + thalachh + oldpeak + thall + exng + slp , data = heart_cor, family = "binomial")
summary(model)
## 
## Call:
## glm(formula = output ~ caa + cp + thalachh + oldpeak + thall + 
##     exng + slp, family = "binomial", data = heart_cor)
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)   
## (Intercept) -2.89082    3.92547  -0.736  0.46147   
## caa         -1.05345    0.59577  -1.768  0.07702 . 
## cp           1.39852    0.50607   2.763  0.00572 **
## thalachh     0.02113    0.02338   0.904  0.36625   
## oldpeak      0.03849    0.41927   0.092  0.92685   
## thall       -1.62496    0.72600  -2.238  0.02521 * 
## exng         0.23951    1.11191   0.215  0.82945   
## slp          1.49037    0.92222   1.616  0.10608   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 88.239  on 64  degrees of freedom
## Residual deviance: 42.647  on 57  degrees of freedom
## AIC: 58.647
## 
## Number of Fisher Scoring iterations: 6
# Predicciones usando el modelo
predictions <- predict(model, type = "response")
predictions
##            1            2            3            4            5            6 
## 0.9496668272 0.8106133176 0.9669085946 0.9889773632 0.6372489337 0.6249387358 
##            7            8            9           10           11           12 
## 0.7890414943 0.3940508372 0.9532766379 0.5817885975 0.8263138884 0.9423897369 
##           13           14           15           16           17           18 
## 0.9457359288 0.8490455084 0.0997258481 0.9382056251 0.4146029780 0.7795932698 
##           19           20           21           22           23           24 
## 0.5825304875 0.6505375318 0.9018130114 0.8836424684 0.7789863409 0.9908337609 
##           25           26           27           28           29           30 
## 0.8129211119 0.7717296411 0.5755694374 0.0053160649 0.1900076029 0.0009214471 
##           31           32           33           34           35           36 
## 0.0301514188 0.0064653257 0.0116879752 0.8007518729 0.1025248386 0.4979888261 
##           37           38           39           40           41           42 
## 0.0004883961 0.0069288119 0.0515300589 0.0024043686 0.0012678771 0.0082837088 
##           43           44           45           46           47           48 
## 0.7836757666 0.0011379741 0.0180753681 0.1401183450 0.1994710715 0.0939368352 
##           49           50           51           52           53           54 
## 0.0055751701 0.1179045005 0.4206745101 0.9753135831 0.0022593635 0.0342543663 
##           55           56           57           58           59           60 
## 0.2491202146 0.0097743910 0.1408743639 0.0064744747 0.2767069883 0.6570094540 
##           61           62           63           64           65 
## 0.0804046930 0.1544141416 0.4308576029 0.0394550381 0.0051052790

El modelo de regresión logística tiene como objetivo predecir la probabilidad de ocurrencia de enfermedades cardíacas (output) a partir de un conjunto de variables predictoras (cp, thalachh, thall, oldpeak, exng, slp y caa).

  • cp (Tipo de dolor torácico) : Existe una relación positiva significativa entre el tipo de dolor torácico y la probabilidad de enfermedades cardíacas (coeficiente 1.39852, p-valor 0.00572). Los mayores niveles de este tipo de dolor están asociados con un aumento en la probabilidad de enfermedades cardíacas.
  • thalachh (Frecuencia cardíaca máxima alcanzada) : No se encuentra una asociación significativa (coeficiente 0.02113, p-valor 0.36625) con la ocurrencia de enfermedades cardíacas en este modelo. Es importante tener en cuenta que su efecto parece no ser significativo en la predicción de enfermedades cardíacas.
  • thall (Tasa de mortalidad) : Muestra una relación negativa significativa con las enfermedades cardíacas (-1.62496, p-valor 0.02521). Niveles más altos de esta variable se relacionan con una disminución en la probabilidad de enfermedades cardíacas.
  • exng (Angina inducida por el ejercicio) : No muestra una relación significativa (p-valor alto: 0.82945) con la presencia de enfermedades cardíacas en este modelo. No parece ser un factor determinante en la predicción de enfermedades cardíacas según este análisis.
  • slp (Pendiente del segmento ST máximo del ejercicio) : Indica una posible asociación positiva (coeficiente 1.49037), aunque no es estadísticamente significativa al 95% (p-valor 0.10608). Esta variable podría tener cierta influencia en la probabilidad de enfermedades cardíacas, aunque se requiere precaución al interpretar su efecto debido a su p-value relativamente alto.
  • caa (Número de grandes vasos) : Muestra una posible relación negativa (-1.05345), aunque no es estadísticamente significativa al 95% (p-valor 0.07702). Su efecto en la predicción de enfermedades cardíacas parece sugerir una disminución en la probabilidad, pero se necesitarían más datos para confirmar su influencia.
  • oldpeak (Depresión inducida por el ejercicio) : En este modelo, la variable “oldpeak” no muestra una asociación significativa (coeficiente 0.03849, p-valor 0.92685) con la presencia de enfermedades cardíacas. Según este análisis, la depresión del segmento ST inducida por el ejercicio no parece influir en la probabilidad de ocurrencia de enfermedades cardíacas.

En resumen, las variables “cp” (Tipo de dolor torácico) y “thall” (Tasa de mortalidad) parecen ser las más influyentes para predecir la ocurrencia de enfermedades cardíacas en este modelo. Otras variables como “slp”, “caa”, “thalachh” y “exng” muestran asociaciones que podrían ser relevantes a diferentes niveles de confianza o podrían necesitar más datos para una conclusión más sólida.

El AIC del modelo es 58.647, lo que sugiere que este modelo podría mejorar con ajustes adicionales o la inclusión de más variables predictoras. La deviance residual es significativamente menor que la deviance nula, indicando que las variables incluidas en el modelo explican parte de la variabilidad en la presencia de enfermedades cardíacas.

6 Resolución del problema

Los hallazgos de este análisis proporcionan claridad sobre las variables más relevantes para predecir la ocurrencia de enfermedades cardíacas.

El tipo de dolor torácico (cp) y la tasa de mortalidad (thall) emergen como indicadores significativos de enfermedades cardíacas, mostrando asociaciones claras con la presencia de esta condición en el análisis de regresión logística. Además, la frecuencia cardíaca máxima alcanzada (thalachh) y el número de grandes vasos (caa) también muestran vínculos potenciales, aunque su confirmación estadística podría requerir más datos.

La angina inducida por el ejercicio (exng) y la pendiente del segmento ST máximo del ejercicio (slp) no presentan asociaciones estadísticamente significativas con la presencia de enfermedades cardíacas según este análisis.

La depresión inducida por el ejercicio (oldpeak), aunque no muestra asociación significativa, no parece influir en la probabilidad de ocurrencia de enfermedades cardíacas en este modelo.

Estos resultados subrayan la importancia del dolor torácico y la tasa de mortalidad como predictores potenciales de enfermedades cardíacas. Sin embargo, se destaca la necesidad de mayor validación para algunas variables y la posibilidad de ajustes adicionales en el modelo, ya que algunos factores podrían tener influencias más sutiles o necesitar mayor evidencia para confirmar su contribución a la predicción de esta condición médica.